home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / Tickle-4.0 (tcl) / tcl / extend / tests / tcllib.test < prev    next >
Encoding:
Text File  |  1993-10-26  |  8.7 KB  |  312 lines  |  [TEXT/MPS ]
  1. #
  2. # tcllib.test
  3. #
  4. # Tests for commands and functionallity involved in demand loadable Tcl
  5. # libraries.
  6. #---------------------------------------------------------------------------
  7. # Copyright 1992-1993 Karl Lehenbauer and Mark Diekhans.
  8. #
  9. # Permission to use, copy, modify, and distribute this software and its
  10. # documentation for any purpose and without fee is hereby granted, provided
  11. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  12. # Mark Diekhans make no representations about the suitability of this
  13. # software for any purpose.  It is provided "as is" without express or
  14. # implied warranty.
  15. #------------------------------------------------------------------------------
  16. # $Id: tcllib.test,v 2.4 1993/07/20 08:35:45 markd Exp $
  17. #------------------------------------------------------------------------------
  18. #
  19.  
  20. if {[info procs test] == ""} then {source testlib.tcl}
  21. eval $SAVED_UNKNOWN
  22.  
  23. # Load the slow-path part of the unknown command.  Otherwise the unknown
  24. # command will not work when the loadpath is changed.
  25.  
  26. if ![auto_load tclx_unknown2] {
  27.     error "can't auto_load tclx_unknown2"
  28. }
  29.  
  30. global save_auto_path auto_path
  31. set save_auto_path $auto_path
  32. set auto_path {}
  33. catch {unset auto_path}
  34.  
  35. if {[id user] == "root"} {
  36.     puts stderr "*************************************************************"
  37.     puts stderr "You are running as `root', certain tcllib tests will be"
  38.     puts stderr "skipped"
  39.     puts stderr "*************************************************************"
  40. }
  41.  
  42. #
  43. # Since we have libraries coming and going in this test, we need to
  44. # reset the environment.  
  45. #
  46. proc TclLibReset {} {
  47.     global auto_execs auto_index auto_pkg_index auto_path
  48.     catch {unset auto_execs}
  49.     catch {unset auto_index}
  50.     catch {unset auto_pkg_index}
  51.     
  52.     # This alters the internal knowledge of the last path that was loaded.
  53.     if [info exists auto_path] {
  54.         set save_auto_path $auto_path
  55.     } else {
  56.         set save_auto_path {}
  57.     }
  58.     set auto_path {}
  59.     auto_load
  60.     set auto_path $save_auto_path
  61. }
  62.  
  63. proc TclLibCleanUp {} {
  64.     catch {chmod +rwx tcllib1.dir}
  65.     catch {chmod +rwx tcllib2.dir}
  66.     unlink -nocomplain [glob -nocomplain tcllib1.dir/* tcllib1.dir/.*]
  67.     unlink -nocomplain [glob -nocomplain tcllib2.dir/* tcllib2.dir/.*]
  68.     catch {rmdir tcllib1.dir}
  69.     catch {rmdir tcllib2.dir}
  70.     TclLibReset
  71. }
  72.  
  73. TclLibCleanUp
  74.  
  75. proc PutFile {fileName args} {
  76.     set fp [open $fileName w]
  77.     foreach line $args {
  78.         puts $fp $line
  79.     }
  80.     close $fp
  81. }
  82.  
  83. catch {rename buildpackageindex {}} ;# Make sure we can autoload this
  84.  
  85. #
  86. # Test parameter checking for the basic commands that are implemented
  87. # in C.
  88. #
  89.  
  90. Test tcllib-1.1 {command parameter checking} {
  91.     auto_load a b c d
  92. } 1 {wrong # args: auto_load ?command?}
  93.  
  94. Test tcllib-1.2 {command parameter checking} {
  95.     loadlibindex
  96. } 1 {wrong # args: loadlibindex libFile}
  97.  
  98. Test tcllib-1.3 {command parameter checking} {
  99.     loadlibindex a b c d
  100. } 1 {wrong # args: loadlibindex libFile}
  101.  
  102. #
  103. # Test error recovery from bogus paths (should ignore path and not find proc)
  104. #
  105.  
  106. Test tcllib-2.1 {bogus path test} {
  107.     set auto_path [list /bogus/dir/path/no/work [pwd]/../tclmaster]
  108.     TclLibAAA
  109. } 1 {invalid command name "TclLibAAA"}
  110.  
  111. catch {rename buildpackageindex {}} ;# Make sure we can autoload this
  112.  
  113. Test tcllib-2.2 {bogus path test} {
  114.     set auto_path [list ~bogususerman/tcllib [pwd]/../tclmaster]
  115.     TclLibAAA
  116. } 1 {invalid command name "TclLibAAA"}
  117.  
  118. Test tcllib-2.3 {bogus path test} {
  119.     set auto_path [pwd]/../tclmaster
  120.     set auto_path [list /bogus/dir/path/no/work]
  121.     TclLibAAA
  122. } 1 {invalid command name "TclLibAAA"}
  123.  
  124.  
  125. #
  126. # Test error recovery from bogus package library indices.
  127. #
  128.  
  129. proc BuildTestLib {name {pbase TclLibAA}} {
  130.    PutFile $name \
  131.         "#@package: $name-package ${pbase}B ${pbase}C ${pbase}D" \
  132.         "proc ${pbase}B {} {return \"***${pbase}B***\"}" \
  133.         "proc ${pbase}C {} {return \"***${pbase}C***\"}" \
  134.         "proc ${pbase}D {} {return \"***${pbase}D***\"}"
  135. }
  136.  
  137. mkdir tcllib1.dir
  138. BuildTestLib tcllib1.dir/test1.tlib
  139. PutFile tcllib1.dir/test1.tndx {bogus
  140. data}
  141.  
  142. TclLibReset
  143. set auto_path [list [pwd]/tcllib1.dir [pwd]/../tclmaster]
  144.  
  145. TestReg tcllib-3.1 {bogus package library index} {
  146.     TclLibAAB
  147. } 1 {^format error in library index "/.*test1.tndx" \(bogus\)$}
  148.  
  149. catch {rename buildpackageindex {}} ;# Make sure we can autoload this
  150.  
  151. PutFile tcllib1.dir/test1.tndx \
  152.     {test1-package 56 240 TclLibAAB TclLibAAC TclLibAAD}
  153.  
  154. TestReg tcllib-3.2 {bogus package library index} {
  155.     TclLibAAB
  156. } 1 {^range to eval outside of file bounds "/.*test1.tlib"$}
  157.  
  158.  
  159. PutFile tcllib1.dir/test1.tndx \
  160.     {test1-package -1 140 TclLibAAB TclLibAAC TclLibAAD}
  161.  
  162. TestReg tcllib-3.3 {bogus package library index} {
  163.     TclLibAAB
  164. } 1 {^range to eval outside of file bounds "/.*test1.tlib"$}
  165.  
  166. catch {rename buildpackageindex {}} ;# Make sure we can autoload this
  167.  
  168. PutFile tcllib1.dir/test1.tndx \
  169.     {test1-package 156 40 TclLibAAB TclLibAAC TclLibAAD}
  170.  
  171. TestReg tcllib-3.4 {bogus package library index} {
  172.     TclLibAAB
  173. } 1 {^range to eval outside of file bounds "/}
  174.  
  175. TclLibReset
  176. set auto_path [list [pwd]/tcllib2.dir [pwd]/../tclmaster]
  177.  
  178. if {[id user] != "root"} {
  179.     Test tcllib-4.1 {bad rebuild package library index} {
  180.         global errorCode errorInfo
  181.         mkdir tcllib2.dir
  182.         BuildTestLib tcllib2.dir/test1.tlib TclLibAB
  183.         chmod -w tcllib2.dir
  184.         list [catch {TclLibABB} msg] [crange $msg 0 25] \
  185.              [lrange $errorCode 0 1] \
  186.              [string match "*while loading Tcl library index*" $errorInfo] \
  187.              [string match "*while auto loading \"TclLibABB\"*" $errorInfo]
  188.     } 0 {1 {building package index for} {POSIX EACCES} 1 1}
  189. }
  190.  
  191. TclLibCleanUp
  192. mkdir tcllib1.dir
  193. set auto_path [list [pwd]/tcllib1.dir [pwd]/../tclmaster]
  194.  
  195. PutFile tcllib1.dir/tclIndex "#" "badline" "nukearray nukearray.tmp" \
  196.     "baz baz.tmp"
  197.  
  198. Test tcllib-5.1 {bogus Ousterhout library index} {
  199.     nukearray
  200. } 1 {recursive load of indexes (probable invalid command while loading index)}
  201.  
  202. PutFile tcllib1.dir/tclIndex "# Tcl autoload index file, version 2.0" \
  203.         {set auto_index(parray)   " source $dir/parray.tcl"} \
  204.         {set auto_index(nukearray) "source $dir/spazzzzzzzz"} \
  205.  
  206. TestReg tcllib-5.2 {missing file found with Ousterhout library index} {
  207.     nukearray
  208. } 1 {^couldn't read file}
  209.  
  210. PutFile tcllib1.dir/nukearray.tmp {proc nukearray {} {}}
  211. chmod 000 tcllib1.dir/nukearray.tmp
  212.  
  213. if {[id user] != "root"} {
  214.     TestReg tcllib-5.3 {missing file found with Ousterhout library index} {
  215.         nukearray
  216.     } 1 {^couldn't read file}
  217. }
  218.  
  219. TclLibCleanUp
  220. mkdir tcllib1.dir
  221.  
  222. BuildTestLib  tcllib1.dir/test2.tlib TclLibAC
  223. set auto_path [list [pwd]/tcllib1.dir [pwd]/../tclmaster]
  224.  
  225. PutFile tcllib1.dir/tclIndex "# Tcl autoload index file, version 2.0" \
  226.         {set auto_index(parray)   " source $dir/parray.tcl"} \
  227.         {set auto_index(nukearray) "source $dir/nukearray.tmp"}
  228. PutFile tcllib1.dir/nukearray.tmp {proc nukearray {} {return "@nukearray@"}}
  229.  
  230. Test tcllib-6.1 {successful library access} {
  231.     TclLibACB
  232. } 0 {***TclLibACB***}
  233.  
  234. Test tcllib-6.2 {successful library access} {
  235.     TclLibACB
  236. } 0 {***TclLibACB***}
  237.  
  238. Test tcllib-6.3 {successful library access} {
  239.     nukearray
  240. } 0 {@nukearray@}
  241.  
  242. #
  243. # Test skipping of duplicate packages.  Also make sure loadlibindex overrides
  244. # existing package definitions.
  245. #
  246. TclLibCleanUp
  247. mkdir {tcllib1.dir tcllib2.dir}
  248. set auto_path [list [pwd]/tcllib1.dir [pwd]/tcllib2.dir [pwd]/../tclmaster]
  249.  
  250. PutFile tcllib1.dir/test1.tlib \
  251.     {#@package: test-pkg DupPkgTest} \
  252.     {proc DupPkgTest {} {return {Version-1}}
  253. }
  254. PutFile tcllib2.dir/test2.tlib \
  255.     {#@package: test-pkg DupPkgTest} \
  256.     {proc DupPkgTest {} {return {Version-2}}
  257. }
  258.  
  259. Test tcllib-7.1 {Duplicate package handling} {
  260.     DupPkgTest
  261. } 0 {Version-1}
  262.  
  263. TclLibReset
  264. rename DupPkgTest {}
  265.  
  266. Test tcllib-7.2 {Duplicate package handling} {
  267.     lrmdups {a b c}  ;# Force load of indices.
  268.     loadlibindex tcllib2.dir/test2.tlib
  269.     DupPkgTest
  270. } 0 {Version-2}
  271.  
  272. #
  273. # Test backslash parsing in #@package: line.
  274. #
  275. TclLibCleanUp
  276. mkdir {tcllib1.dir tcllib2.dir}
  277. set auto_path [list [pwd]/tcllib1.dir [pwd]/tcllib2.dir [pwd]/../tclmaster]
  278.  
  279. PutFile tcllib1.dir/test1.tlib \
  280.     {#@package: test-pkg procAAA \\} \
  281.     {           procBBB \\         } \
  282.     {           procCCC            } \
  283.     {proc procAAA {} {return {AAA}}} \
  284.     {proc procBBB {} {return {BBB}}} \
  285.     {proc procCCC {} {return {CCC}}}
  286.  
  287. Test tcllib-8.1 {backslash parsing in package headers} {
  288.     TclLibReset
  289.     procAAA
  290. } 0 {AAA}
  291.  
  292.  
  293. Test tcllib-8.2 {backslash parsing in package headers} {
  294.     TclLibReset
  295.     procBBB
  296. } 0 {BBB}
  297.  
  298.  
  299. Test tcllib-8.3 {backslash parsing in package headers} {
  300.     TclLibReset
  301.     procCCC
  302. } 0 {CCC}
  303.  
  304. TclLibCleanUp
  305.  
  306. rename TclLibCleanUp {}
  307. rename PutFile {}
  308. rename TclLibReset {}
  309.  
  310. set auto_path $save_auto_path
  311. rename unknown {}
  312.